#' Score functions for sorting `TableTrees`

#'

#' @inheritParams gen_args

#'

#' @return A single numeric value indicating score according to the relevant metric for `tt`, to be used when sorting.

#'

#' @export

#' @rdname score_funs

cont_n_allcols <- function(tt) {

    )

  }

  ))

}

#' @param j (`numeric(1)`)\cr index of column used for scoring.

#'

#' @seealso For examples and details, please read the documentation for [sort_at_path()] and the

#' [Sorting and Pruning](https://insightsengineering.github.io/rtables/latest-tag/articles/sorting_pruning.html)

#' vignette.

#'

#' @export

#' @rdname score_funs

cont_n_onecol <- function(j) {

      )

    }

  }

}

#' Sorting a table at a specific path

#'

#' Main sorting function to order the sub-structure of a `TableTree` at a particular path in the table tree.

#'

#' @inheritParams gen_args

#' @param scorefun (`function`)\cr scoring function. Should accept the type of children directly under the position

#'   at `path` (either `VTableTree`, `VTableRow`, or `VTableNodeInfo`, which covers both) and return a numeric value

#'   to be sorted.

#' @param decreasing (`flag`)\cr whether the scores generated by `scorefun` should be sorted in decreasing order. If

#'   unset (the default of `NA`), it is set to `TRUE` if the generated scores are numeric and `FALSE` if they are

#'   characters.

#' @param na.pos (`string`)\cr what should be done with children (sub-trees/rows) with `NA` scores. Defaults to

#'   `"omit"`, which removes them. Other allowed values are `"last"`  and `"first"`, which indicate where `NA` scores

#'   should be placed in the order.

#' @param .prev_path (`character`)\cr internal detail, do not set manually.

#'

#' @return A `TableTree` with the same structure as `tt` with the exception that the requested sorting has been done

#'   at `path`.

#'

#' @details

#' `sort_at_path`, given a path, locates the (sub)table(s) described by the path (see below for handling of the `"*"`

#' wildcard). For each such subtable, it then calls `scorefun` on each direct child of the table, using the resulting

#' scores to determine their sorted order. `tt` is then modified to reflect each of these one or more sorting

#' operations.

#'

#' In `path`, a leading `"root"` element will be ignored, regardless of whether this matches the object name (and thus

#' actual root path name) of `tt`. Including `"root"` in paths where it does not match the name of `tt` may mask deeper

#' misunderstandings of how valid paths within a `TableTree` object correspond to the layout used to originally declare

#' it, which we encourage users to avoid.

#'

#' `path` can include the "wildcard" `"*"` as a step, which translates roughly to *any* node/branching element and means

#' that each child at that step will be *separately* sorted based on `scorefun` and the remaining `path` entries. This

#' can occur multiple times in a path.

#'

#' A list of valid (non-wildcard) paths can be seen in the `path` column of the `data.frame` created by

#' [formatters::make_row_df()] with the `visible_only` argument set to `FALSE`. It can also be inferred from the

#' summary given by [table_structure()].

#'

#' Note that sorting needs a deeper understanding of table structure in `rtables`. Please consider reading the related

#' vignette

#' ([Sorting and Pruning](https://insightsengineering.github.io/rtables/latest-tag/articles/sorting_pruning.html))

#' and explore table structure with useful functions like [table_structure()] and [row_paths_summary()]. It is also

#' very important to understand the difference between "content" rows and "data" rows. The first one analyzes and

#' describes the split variable generally and is generated with [summarize_row_groups()], while the second one is

#' commonly produced by calling one of the various [analyze()] instances.

#'

#' Built-in score functions are [cont_n_allcols()] and [cont_n_onecol()]. They are both working with content rows

#' (coming from [summarize_row_groups()]) while a custom score function needs to be used on `DataRow`s. Here, some

#' useful descriptor and accessor functions (coming from related vignette):

#'  - [cell_values()] - Retrieves a named list of a `TableRow` or `TableTree` object's values.

#'  - [formatters::obj_name()] - Retrieves the name of an object. Note this can differ from the label that is

#'  displayed (if any is)  when printing.

#'  - [formatters::obj_label()] - Retrieves the display label of an object. Note this can differ from the name that

#'  appears in the path.

#'  - [content_table()] - Retrieves a `TableTree` object's content table (which contains its summary rows).

#'  - [tree_children()] - Retrieves a `TableTree` object's direct children (either subtables, rows or possibly a mix

#'    thereof, though that should not happen in practice).

#'

#' @seealso

#' * Score functions [cont_n_allcols()] and [cont_n_onecol()].

#' * [formatters::make_row_df()] and [table_structure()] for pathing information.

#' * [tt_at_path()] to select a table's (sub)structure at a given path.

#'

#' @examples

#' # Creating a table to sort

#'

#' # Function that gives two statistics per table-tree "leaf"

#' more_analysis_fnc <- function(x) {

#'   in_rows(

#'     "median" = median(x),

#'     "mean" = mean(x),

#'     .formats = "xx.x"

#'   )

#' }

#'

#' # Main layout of the table

#' raw_lyt <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   split_rows_by(

#'     "RACE",

#'     split_fun = drop_and_remove_levels("WHITE") # dropping WHITE levels

#'   ) %>%

#'   summarize_row_groups() %>%

#'   split_rows_by("STRATA1") %>%

#'   summarize_row_groups() %>%

#'   analyze("AGE", afun = more_analysis_fnc)

#'

#' # Creating the table and pruning empty and NAs

#' tbl <- build_table(raw_lyt, DM) %>%

#'   prune_table()

#'

#' # Peek at the table structure to understand how it is built

#' table_structure(tbl)

#'

#' #  Sorting only ASIAN sub-table, or, in other words, sorting STRATA elements for

#' # the ASIAN group/row-split. This uses content_table() accessor function as it

#' # is a "ContentRow". In this case, we also base our sorting only on the second column.

#' sort_at_path(tbl, c("ASIAN", "STRATA1"), cont_n_onecol(2))

#'

#' # Custom scoring function that is working on "DataRow"s

#' scorefun <- function(tt) {

#'   # Here we could use browser()

#'   sum(unlist(row_values(tt))) # Different accessor function

#' }

#' # Sorting mean and median for all the AGE leaves!

#' sort_at_path(tbl, c("RACE", "*", "STRATA1", "*", "AGE"), scorefun)

#'

#' @export

sort_at_path <- function(tt,

                         path,

                         scorefun,

                         decreasing = NA,

                         na.pos = c("omit", "last", "first"),

                         .prev_path = character()) {

  }

  ## XXX hacky fix this!!!

  ## tt_at_path removes root even if actual root table isn't named root, we need to match that behavior

    ## always remove first root element but only add it to

    ## .prev_path (used for error reporting) if it actually matched the name

    }

  }

  }

    ## we sort each child separately based on the score function

    ## and the remaining path

            ## its ok to modify the "path" here because its only ever used for

            ## informative error reporting.

          )

        }

      )

      } else {

      }

      )

    }

  }

  ##    subtree <- tt_at_path(tt, path)

  ## relax this to allow character "scores"

  ## scores <- vapply(kids, scorefun, NA_real_)

    )

  } else {

  }

    )

  }

  }

  }

}

label_pos_values <- c("hidden", "visible", "topleft")

#' @name internal_methods

#' @rdname int_methods

NULL

#' Combine `SplitVector` objects

#'

#' @param x (`SplitVector`)\cr a `SplitVector` object.

#' @param ... splits or `SplitVector` objects.

#'

#' @return Various, but should be considered implementation details.

#'

#' @rdname int_methods

#' @exportMethod c

setMethod("c", "SplitVector", function(x, ...) {

})

## split_rows and split_cols are "recursive method stacks" which follow

## the general pattern of accept object -> call add_*_split on slot of object ->

## update object with value returned from slot method, return object.

##

## Thus each of the methods is idempotent, returning an updated object of the

## same class it was passed. The exception for idempotency is the NULL method

## which constructs a PreDataTableLayouts object with the specified split in the

## correct place.

## The cascading (by class) in this case is as follows for the row case:

## PreDataTableLayouts -> PreDataRowLayout -> SplitVector

#' @param cmpnd_fun (`function`)\cr intended for internal use.

#' @param pos (`numeric(1)`)\cr intended for internal use.

#' @param spl (`Split`)\cr the split.

#'

#' @rdname int_methods

setGeneric(

  "split_rows",

  function(lyt = NULL, spl, pos,

           cmpnd_fun = AnalyzeMultiVars) {

  }

)

#' @rdname int_methods

setMethod("split_rows", "NULL", function(lyt, spl, pos, cmpnd_fun = AnalyzeMultiVars) {

  )

})

#' @rdname int_methods

setMethod(

  "split_rows", "PreDataRowLayout",

  function(lyt, spl, pos, cmpnd_fun = AnalyzeMultiVars) {

    } else {

        )

      }

    }

  }

)

is_analysis_spl <- function(spl) {

}

## note "pos" is ignored here because it is for which nest-chain

## spl should be placed in, NOIT for where in that chain it should go

#' @rdname int_methods

setMethod(

  "split_rows", "SplitVector",

  function(lyt, spl, pos, cmpnd_fun = AnalyzeMultiVars) {

    ## if(is_analysis_spl(spl) &&

    ##    is_analysis_spl(last_rowsplit(lyt))) {

    ##     return(cmpnd_last_rowsplit(lyt, spl, cmpnd_fun))

    ## }

      )

    }

  }

)

#' @rdname int_methods

setMethod(

  "split_rows", "PreDataTableLayouts",

  function(lyt, spl, pos) {

    if (

    ) {

      ##        label_position(spl) <- "hidden"

    }

    }

  }

)

#' @rdname int_methods

setMethod(

  "split_rows", "ANY",

  function(lyt, spl, pos) {

  }

)

## cmpnd_last_rowsplit =====

#' @rdname int_methods

#'

#' @param constructor (`function`)\cr constructor function.

#' @rdname int_methods

setMethod("cmpnd_last_rowsplit", "NULL", function(lyt, spl, constructor) {

  stop("no existing splits to compound with. contact the maintainer") # nocov

})

#' @rdname int_methods

setMethod(

  "cmpnd_last_rowsplit", "PreDataRowLayout",

  function(lyt, spl, constructor) {

  }

)

#' @rdname int_methods

setMethod(

  "cmpnd_last_rowsplit", "SplitVector",

  function(lyt, spl, constructor) {

      )

      ## XXX never reached because AnalzyeMultiVars inherits from

      ## CompoundSplit???

    } else {

    }

  }

)

#' @rdname int_methods

setMethod(

  "cmpnd_last_rowsplit", "PreDataTableLayouts",

  function(lyt, spl, constructor) {

  }

)

#' @rdname int_methods

setMethod(

  "cmpnd_last_rowsplit", "ANY",

  function(lyt, spl, constructor) {

    )

  }

)

## split_cols ====

#' @rdname int_methods

setGeneric(

  "split_cols",

  function(lyt = NULL, spl, pos) {

  }

)

#' @rdname int_methods

setMethod("split_cols", "NULL", function(lyt, spl, pos) {

  )

})

#' @rdname int_methods

setMethod(

  "split_cols", "PreDataColLayout",

  function(lyt, spl, pos) {

    } else {

    }

  }

)

#' @rdname int_methods

setMethod(

  "split_cols", "SplitVector",

  function(lyt, spl, pos) {

  }

)

#' @rdname int_methods

setMethod(

  "split_cols", "PreDataTableLayouts",

  function(lyt, spl, pos) {

  }

)

#' @rdname int_methods

setMethod(

  "split_cols", "ANY",

  function(lyt, spl, pos) {

    )

  }

)

# Constructors =====

## Pipe-able functions to add the various types of splits to the current layout

## for both row and column.  These all act as wrappers to the split_cols and

## split_rows method stacks.

#' Declaring a column-split based on levels of a variable

#'

#' Will generate children for each subset of a categorical variable.

#'

#' @inheritParams lyt_args

#' @param ref_group (`string` or `NULL`)\cr level of `var` that should be considered `ref_group`/reference.

#'

#' @return A `PreDataTableLayouts` object suitable for passing to further layouting functions, and to [build_table()].

#'

#' @inheritSection custom_split_funs Custom Splitting Function Details

#'

#' @examples

#' lyt <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   analyze(c("AGE", "BMRKR2"))

#'

#' tbl <- build_table(lyt, ex_adsl)

#' tbl

#'

#' # Let's look at the splits in more detail

#'

#' lyt1 <- basic_table() %>% split_cols_by("ARM")

#' lyt1

#'

#' # add an analysis (summary)

#' lyt2 <- lyt1 %>%

#'   analyze(c("AGE", "COUNTRY"),

#'     afun = list_wrap_x(summary),

#'     format = "xx.xx"

#'   )

#' lyt2

#'

#' tbl2 <- build_table(lyt2, DM)

#' tbl2

#'

#' @examplesIf require(dplyr)

#' # By default sequentially adding layouts results in nesting

#' library(dplyr)

#'

#' DM_MF <- DM %>%

#'   filter(SEX %in% c("M", "F")) %>%

#'   mutate(SEX = droplevels(SEX))

#'

#' lyt3 <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   split_cols_by("SEX") %>%

#'   analyze(c("AGE", "COUNTRY"),

#'     afun = list_wrap_x(summary),

#'     format = "xx.xx"

#'   )

#' lyt3

#'

#' tbl3 <- build_table(lyt3, DM_MF)

#' tbl3

#'

#' # nested=TRUE vs not

#' lyt4 <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   split_rows_by("SEX", split_fun = drop_split_levels) %>%

#'   split_rows_by("RACE", split_fun = drop_split_levels) %>%

#'   analyze("AGE")

#' lyt4

#'

#' tbl4 <- build_table(lyt4, DM)

#' tbl4

#'

#' lyt5 <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   split_rows_by("SEX", split_fun = drop_split_levels) %>%

#'   analyze("AGE") %>%

#'   split_rows_by("RACE", nested = FALSE, split_fun = drop_split_levels) %>%

#'   analyze("AGE")

#' lyt5

#'

#' tbl5 <- build_table(lyt5, DM)

#' tbl5

#'

#' @author Gabriel Becker

#' @export

split_cols_by <- function(lyt,

                          var,

                          labels_var = var,

                          split_label = var,

                          split_fun = NULL,

                          format = NULL,

                          nested = TRUE,

                          child_labels = c("default", "visible", "hidden"),

                          extra_args = list(),

                          ref_group = NULL,

                          show_colcounts = FALSE,

                          colcount_format = NULL) { ## ,

    )

  } else {

    )

  }

}

## .tl_indent ====

setMethod(

  ".tl_indent_inner", "PreDataTableLayouts",

)

setMethod(

  ".tl_indent_inner", "PreDataRowLayout",

  function(lyt) {

    } else {

    }

  }

)

setMethod(

  ".tl_indent_inner", "SplitVector",

  function(lyt) {

  }

) ## length(lyt)  - 1L)

.tl_indent <- function(lyt, nested = TRUE) {

  } else {

  }

}

#' Add rows according to levels of a variable

#'

#' @inheritParams lyt_args

#'

#' @inherit split_cols_by return

#'

#' @inheritSection custom_split_funs Custom Splitting Function Details

#'

#' @note

#' If `var` is a factor with empty unobserved levels and `labels_var` is specified, it must also be a factor

#' with the same number of levels as `var`. Currently the error that occurs when this is not the case is not very

#' informative, but that will change in the future.

#'

#' @examples

#' lyt <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   split_rows_by("RACE", split_fun = drop_split_levels) %>%

#'   analyze("AGE", mean, var_labels = "Age", format = "xx.xx")

#'

#' tbl <- build_table(lyt, DM)

#' tbl

#'

#' lyt2 <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   split_rows_by("RACE") %>%

#'   analyze("AGE", mean, var_labels = "Age", format = "xx.xx")

#'

#' tbl2 <- build_table(lyt2, DM)

#' tbl2

#'

#' lyt3 <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   split_cols_by("SEX") %>%

#'   summarize_row_groups(label_fstr = "Overall (N)") %>%

#'   split_rows_by("RACE",

#'     split_label = "Ethnicity", labels_var = "ethn_lab",

#'     split_fun = drop_split_levels

#'   ) %>%

#'   summarize_row_groups("RACE", label_fstr = "%s (n)") %>%

#'   analyze("AGE", var_labels = "Age", afun = mean, format = "xx.xx")

#'

#' lyt3

#'

#' @examplesIf require(dplyr)

#' library(dplyr)

#'

#' DM2 <- DM %>%

#'   filter(SEX %in% c("M", "F")) %>%

#'   mutate(

#'     SEX = droplevels(SEX),

#'     gender_lab = c(

#'       "F" = "Female", "M" = "Male",

#'       "U" = "Unknown",

#'       "UNDIFFERENTIATED" = "Undifferentiated"

#'     )[SEX],

#'     ethn_lab = c(

#'       "ASIAN" = "Asian",

#'       "BLACK OR AFRICAN AMERICAN" = "Black or African American",

#'       "WHITE" = "White",

#'       "AMERICAN INDIAN OR ALASKA NATIVE" = "American Indian or Alaska Native",

#'       "MULTIPLE" = "Multiple",

#'       "NATIVE HAWAIIAN OR OTHER PACIFIC ISLANDER" =

#'         "Native Hawaiian or Other Pacific Islander",

#'       "OTHER" = "Other", "UNKNOWN" = "Unknown"

#'     )[RACE]

#'   )

#'

#' tbl3 <- build_table(lyt3, DM2)

#' tbl3

#'

#' @author Gabriel Becker

#' @export

split_rows_by <- function(lyt,

                          var,

                          labels_var = var,

                          split_label = var,

                          split_fun = NULL,

                          format = NULL,

                          na_str = NA_character_,

                          nested = TRUE,

                          child_labels = c("default", "visible", "hidden"),

                          label_pos = "hidden",

                          indent_mod = 0L,

                          page_by = FALSE,

                          page_prefix = split_label,

                          section_div = NA_character_) {

  )

}

#' Associate multiple variables with columns

#'

#' In some cases, the variable to be ultimately analyzed is most naturally defined on a column, not a row, basis.

#' When we need columns to reflect different variables entirely, rather than different levels of a single

#' variable, we use `split_cols_by_multivar`.

#'

#' @inheritParams lyt_args

#'

#' @inherit split_cols_by return

#'

#' @seealso [analyze_colvars()]

#'

#' @examplesIf require(dplyr)

#' library(dplyr)

#'

#' ANL <- DM %>% mutate(value = rnorm(n()), pctdiff = runif(n()))

#'

#' ## toy example where we take the mean of the first variable and the

#' ## count of >.5 for the second.

#' colfuns <- list(

#'   function(x) in_rows(mean = mean(x), .formats = "xx.x"),

#'   function(x) in_rows("# x > 5" = sum(x > .5), .formats = "xx")

#' )

#'

#' lyt <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   split_cols_by_multivar(c("value", "pctdiff")) %>%

#'   split_rows_by("RACE",

#'     split_label = "ethnicity",

#'     split_fun = drop_split_levels

#'   ) %>%

#'   summarize_row_groups() %>%

#'   analyze_colvars(afun = colfuns)

#' lyt

#'

#' tbl <- build_table(lyt, ANL)

#' tbl

#'

#' @author Gabriel Becker

#' @export

split_cols_by_multivar <- function(lyt,

                                   vars,

                                   split_fun = NULL,

                                   varlabels = vars,

                                   varnames = NULL,

                                   nested = TRUE,

                                   extra_args = list(),

                                   ## for completeness even though it doesn't make sense

                                   show_colcounts = FALSE,

                                   colcount_format = NULL) {

  )

}

#' Associate multiple variables with rows

#'

#' When we need rows to reflect different variables rather than different

#' levels of a single variable, we use `split_rows_by_multivar`.

#'

#' @inheritParams lyt_args

#'

#' @inherit split_rows_by return

#'

#' @seealso [split_rows_by()] for typical row splitting, and [split_cols_by_multivar()] to perform the same type of

#'   split on a column basis.

#'

#' @examples

#' lyt <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   split_rows_by_multivar(c("SEX", "STRATA1")) %>%

#'   summarize_row_groups() %>%

#'   analyze(c("AGE", "SEX"))

#'

#' tbl <- build_table(lyt, DM)

#' tbl

#'

#' @export

split_rows_by_multivar <- function(lyt,

                                   vars,

                                   split_fun = NULL,

                                   split_label = "",

                                   varlabels = vars,

                                   format = NULL,

                                   na_str = NA_character_,

                                   nested = TRUE,

                                   child_labels = c("default", "visible", "hidden"),

                                   indent_mod = 0L,

                                   section_div = NA_character_,

                                   extra_args = list()) {

  )

}

#' Split on static or dynamic cuts of the data

#'

#' Create columns (or row splits) based on values (such as quartiles) of `var`.

#'

#' @inheritParams lyt_args

#'

#' @details For dynamic cuts, the cut is transformed into a static cut by [build_table()] *based on the full dataset*,

#' before proceeding. Thus even when nested within another split in column/row space, the resulting split will reflect

#' the overall values (e.g., quartiles) in the dataset, NOT the values for subset it is nested under.

#'

#' @inherit split_cols_by return

#'

#' @examplesIf require(dplyr)

#' library(dplyr)

#'

#' # split_cols_by_cuts

#' lyt <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   split_cols_by_cuts("AGE",

#'     split_label = "Age",

#'     cuts = c(0, 25, 35, 1000),

#'     cutlabels = c("young", "medium", "old")

#'   ) %>%

#'   analyze(c("BMRKR2", "STRATA2")) %>%

#'   append_topleft("counts")

#'

#' tbl <- build_table(lyt, ex_adsl)

#' tbl

#'

#' # split_rows_by_cuts

#' lyt2 <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   split_rows_by_cuts("AGE",

#'     split_label = "Age",

#'     cuts = c(0, 25, 35, 1000),

#'     cutlabels = c("young", "medium", "old")

#'   ) %>%

#'   analyze(c("BMRKR2", "STRATA2")) %>%

#'   append_topleft("counts")

#'

#'

#' tbl2 <- build_table(lyt2, ex_adsl)

#' tbl2

#'

#' # split_cols_by_quartiles

#'

#' lyt3 <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   split_cols_by_quartiles("AGE", split_label = "Age") %>%

#'   analyze(c("BMRKR2", "STRATA2")) %>%

#'   append_topleft("counts")

#'

#' tbl3 <- build_table(lyt3, ex_adsl)

#' tbl3

#'

#' # split_rows_by_quartiles

#' lyt4 <- basic_table(show_colcounts = TRUE) %>%

#'   split_cols_by("ARM") %>%

#'   split_rows_by_quartiles("AGE", split_label = "Age") %>%

#'   analyze("BMRKR2") %>%

#'   append_topleft(c("Age Quartiles", " Counts BMRKR2"))

#'

#' tbl4 <- build_table(lyt4, ex_adsl)

#' tbl4

#'

#' # split_cols_by_cutfun

#' cutfun <- function(x) {

#'   cutpoints <- c(

#'     min(x),

#'     mean(x),

#'     max(x)

#'   )

#'

#'   names(cutpoints) <- c("", "Younger", "Older")

#'   cutpoints

#' }

#'

#' lyt5 <- basic_table() %>%

#'   split_cols_by_cutfun("AGE", cutfun = cutfun) %>%

#'   analyze("SEX")

#'

#' tbl5 <- build_table(lyt5, ex_adsl)

#' tbl5

#'

#' # split_rows_by_cutfun

#' lyt6 <- basic_table() %>%

#'   split_cols_by("SEX") %>%

#'   split_rows_by_cutfun("AGE", cutfun = cutfun) %>%

#'   analyze("BMRKR2")

#'

#' tbl6 <- build_table(lyt6, ex_adsl)

#' tbl6

#'

#' @author Gabriel Becker

#' @export

#' @rdname varcuts

split_cols_by_cuts <- function(lyt, var, cuts,

                               cutlabels = NULL,

                               split_label = var,

                               nested = TRUE,

                               cumulative = FALSE,

                               show_colcounts = FALSE,

                               colcount_format = NULL) {

  )

  ## if(cumulative)

  ##     spl = as(spl, "CumulativeCutSplit")

}

#' @export

#' @rdname varcuts

split_rows_by_cuts <- function(lyt, var, cuts,

                               cutlabels = NULL,

                               split_label = var,

                               format = NULL,

                               na_str = NA_character_,

                               nested = TRUE,

                               cumulative = FALSE,

                               label_pos = "hidden",

                               section_div = NA_character_) {

  ##    VarStaticCutSplit(

  )

  ## if(cumulative)

  ##     spl = as(spl, "CumulativeCutSplit")

}

#' @export

#' @rdname varcuts

split_cols_by_cutfun <- function(lyt, var,

                                 cutfun = qtile_cuts,

                                 cutlabelfun = function(x) NULL,

                                 split_label = var,

                                 nested = TRUE,

                                 extra_args = list(),

                                 cumulative = FALSE,

                                 show_colcounts = FALSE,

                                 colcount_format = NULL) {

  )

}

#' @export

#' @rdname varcuts

split_cols_by_quartiles <- function(lyt, var, split_label = var,

                                    nested = TRUE,

                                    extra_args = list(),

                                    cumulative = FALSE,

                                    show_colcounts = FALSE,

                                    colcount_format = NULL) {

      )

    },

  )

  ## spl = VarDynCutSplit(var, split_label, cutfun = qtile_cuts,

  ##                      cutlabelfun = function(x) c("[min, Q1]",

  ##                                                "(Q1, Q2]",

  ##                                                "(Q2, Q3]",

  ##                                                "(Q3, max]"),

  ##                      split_format = format,

  ##                      extra_args = extra_args,

  ##                      cumulative = cumulative,

  ##                      label_pos = "hidden")

  ## pos = next_cpos(lyt, nested)

  ## split_cols(lyt, spl, pos)

}

#' @export

#' @rdname varcuts

split_rows_by_quartiles <- function(lyt, var, split_label = var,

                                    format = NULL,

                                    na_str = NA_character_,

                                    nested = TRUE,

                                    child_labels = c("default", "visible", "hidden"),

                                    extra_args = list(),

                                    cumulative = FALSE,

                                    indent_mod = 0L,

                                    label_pos = "hidden",

                                    section_div = NA_character_) {

      )

    },

  )

  ## label_pos <- match.arg(label_pos, label_pos_values)

  ## spl = VarDynCutSplit(var, split_label, cutfun = qtile_cuts,

  ##                      cutlabelfun = ,

  ##                      split_format = format,

  ##                      child_labels = child_labels,

  ##                      extra_args = extra_args,

  ##                      cumulative = cumulative,

  ##                      indent_mod = indent_mod,

  ##                      label_pos = label_pos)

  ## pos = next_rpos(lyt, nested)

  ## split_rows(lyt, spl, pos)

}

qtile_cuts <- function(x) {

    "",

  )

}

#' @export

#' @rdname varcuts

split_rows_by_cutfun <- function(lyt, var,

                                 cutfun = qtile_cuts,

                                 cutlabelfun = function(x) NULL,

                                 split_label = var,

                                 format = NULL,

                                 na_str = NA_character_,

                                 nested = TRUE,

                                 child_labels = c("default", "visible", "hidden"),

                                 extra_args = list(),

                                 cumulative = FALSE,

                                 indent_mod = 0L,

                                 label_pos = "hidden",

                                 section_div = NA_character_) {

  )

}

#' .spl_context within analysis and split functions

#'

#' `.spl_context` is an optional parameter for any of rtables' special functions, i.e. `afun` (analysis function

#' in [analyze()]), `cfun` (content or label function in [summarize_row_groups()]), or `split_fun` (e.g. for

#' [split_rows_by()]).

#'

#' @details

#' The `.spl_context` `data.frame` gives information about the subsets of data corresponding to the splits within

#' which the current `analyze` action is nested. Taken together, these correspond to the path that the resulting (set

#' of) rows the analysis function is creating, although the information is in a slightly different form. Each split

#' (which correspond to groups of rows in the resulting table), as well as the initial 'root' "split", is represented

#' via the following columns:

#'

#' \describe{

#'   \item{split}{The name of the split (often the variable being split).}

#'   \item{value}{The string representation of the value at that split (`split`).}

#'   \item{full_parent_df}{A `data.frame` containing the full data (i.e. across all columns) corresponding to the path

#'     defined by the combination of `split` and `value` of this row *and all rows above this row*.}

#'   \item{all_cols_n}{The number of observations corresponding to the row grouping (union of all columns).}

#'   \item{column for each column in the table structure (*row-split and analyze contexts only*)}{These list columns

#'     (named the same as `names(col_exprs(tab))`) contain logical vectors corresponding to the subset of this row's

#'     `full_parent_df` corresponding to the column.}

#'   \item{cur_col_id}{Identifier of the current column. This may be an internal name, constructed by pasting the

#'     column path together.}

#'   \item{cur_col_subset}{List column containing logical vectors indicating the subset of this row's `full_parent_df`

#'     for the column currently being created by the analysis function.}

#'   \item{cur_col_expr}{List of current column expression. This may be used to filter `.alt_df_row`, or any external

#'     data, by column. Filtering `.alt_df_row` by columns produces `.alt_df`.}

#'   \item{cur_col_n}{Integer column containing the observation counts for that split.}

#'   \item{cur_col_split}{Current column split names. This is recovered from the current column path.}

#'   \item{cur_col_split_val}{Current column split values. This is recovered from the current column path.}

#' }

#'

#' @note

#' Within analysis functions that accept `.spl_context`, the `all_cols_n` and `cur_col_n` columns of the data frame

#' will contain the 'true' observation counts corresponding to the row-group and row-group x column subsets of the

#' data. These numbers will not, and currently cannot, reflect alternate column observation counts provided by the

#' `alt_counts_df`, `col_counts` or `col_total` arguments to [build_table()].

#'

#' @name spl_context

NULL

#' Additional parameters within analysis and content functions (`afun`/`cfun`)

#'

#' @description

#' It is possible to add specific parameters to `afun` and `cfun`, in [analyze()] and [summarize_row_groups()],

#' respectively. These parameters grant access to relevant information like the row split structure (see

#' [spl_context]) and the predefined baseline (`.ref_group`).

#'

#' @details

#' We list and describe all the parameters that can be added to a custom analysis function below:

#'

#' \describe{

#'   \item{.N_col}{Column-wise N (column count) for the full column being tabulated within.}

#'   \item{.N_total}{Overall N (all observation count, defined as sum of column counts) for the tabulation.}

#'   \item{.N_row}{Row-wise N (row group count) for the group of observations being analyzed (i.e. with no

#'     column-based subsetting).}

#'   \item{.df_row}{`data.frame` for observations in the row group being analyzed (i.e. with no column-based

#'     subsetting).}

#'   \item{.var}{Variable being analyzed.}

#'   \item{.ref_group}{`data.frame` or vector of subset corresponding to the `ref_group` column including subsetting

#'     defined by row-splitting. Only required/meaningful if a `ref_group` column has been defined.}

#'   \item{.ref_full}{`data.frame` or vector of subset corresponding to the `ref_group` column without subsetting

#'     defined by row-splitting. Only required/meaningful if a `ref_group` column has been defined.}

#'   \item{.in_ref_col}{Boolean indicating if calculation is done for cells within the reference column.}

#'   \item{.spl_context}{`data.frame` where each row gives information about a previous 'ancestor' split state.

#'     See [spl_context].}

#'   \item{.alt_df_row}{`data.frame`, i.e. the `alt_count_df` after row splitting. It can be used with

#'     `.all_col_exprs` and `.spl_context` information to retrieve current faceting, but for `alt_count_df`.

#'     It can be an empty table if all the entries are filtered out.}

#'   \item{.alt_df}{`data.frame`, `.alt_df_row` but filtered by columns expression. This data present the same

#'     faceting of main data `df`. This also filters `NA`s out if related parameters are set to do so (e.g. `inclNAs`

#'     in [analyze()]). Similarly to `.alt_df_row`, it can be an empty table if all the entries are filtered out.}

#'   \item{.all_col_exprs}{List of expressions. Each of them represents a different column splitting.}

#'   \item{.all_col_counts}{Vector of integers. Each of them represents the global count for each column. It differs

#'     if `alt_counts_df` is used (see [build_table()]).}

#' }

#'

#' @note If any of these formals is specified incorrectly or not present in the tabulation machinery, it will be

#'   treated as if missing. For example, `.ref_group` will be missing if no baseline is previously defined during

#'   data splitting (via `ref_group` parameters in, e.g., [split_rows_by()]). Similarly, if no `alt_counts_df` is

#'   provided to [build_table()], `.alt_df_row` and `.alt_df` will not be present.

#'

#' @name additional_fun_params

NULL

#' Generate rows analyzing variables across columns

#'

#' Adding *analyzed variables* to our table layout defines the primary tabulation to be performed. We do this by

#' adding calls to `analyze` and/or [analyze_colvars()] into our layout pipeline. As with adding further splitting,

#' the tabulation will occur at the current/next level of nesting by default.

#'

#' @inheritParams lyt_args

#' @param section_div (`string`)\cr string which should be repeated as a section divider after the set of rows  defined

#'   by (each sub-analysis/variable) of this analyze instruction, or

#'   `NA_character_` (the default) for no section divider. This section

#'   divider will be overridden by a split-level section divider when

#'   both apply to the same position in the rendered output.

#'

#' @inherit split_cols_by return

#'

#' @details

#' When non-`NULL`, `format` is used to specify formats for all generated rows, and can be a character vector, a

#' function, or a list of functions. It will be repped out to the number of rows once this is calculated during the

#' tabulation process, but will be overridden by formats specified within `rcell` calls in `afun`.

#'

#' The analysis function (`afun`) should take as its first parameter either `x` or `df`. Whichever of these the

#' function accepts will change the behavior when tabulation is performed as follows:

#'

#' - If `afun`'s first parameter is `x`, it will receive the corresponding subset *vector* of data from the relevant

#'   column (from `var` here) of the raw data being used to build the table.

#' - If `afun`'s first parameter is `df`, it will receive the corresponding subset *data frame* (i.e. all columns) of

#'   the raw data being tabulated.

#'

#' In addition to differentiation on the first argument, the analysis function can optionally accept a number of

#' other parameters which, *if and only if* present in the formals, will be passed to the function by the tabulation

#' machinery. These are listed and described in [additional_fun_params].

#'

#' @note None of the arguments described in the Details section can be overridden via `extra_args` or when calling

#'   [make_afun()]. `.N_col` and `.N_total` can be overridden via the `col_counts` argument to [build_table()].

#'   Alternative values for the others must be calculated within `afun` based on a combination of extra arguments and

#'   the unmodified values provided by the tabulation framework.

#'

#' @examples

#' lyt <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   analyze("AGE", afun = list_wrap_x(summary), format = "xx.xx")

#' lyt

#'

#' tbl <- build_table(lyt, DM)

#' tbl

#'

#' lyt2 <- basic_table() %>%

#'   split_cols_by("Species") %>%

#'   analyze(head(names(iris), -1), afun = function(x) {

#'     list(

#'       "mean / sd" = rcell(c(mean(x), sd(x)), format = "xx.xx (xx.xx)"),

#'       "range" = rcell(diff(range(x)), format = "xx.xx")

#'     )

#'   })

#' lyt2

#'

#' tbl2 <- build_table(lyt2, iris)

#' tbl2

#'

#' @author Gabriel Becker

#' @export

analyze <- function(lyt,

                    vars,

                    afun = simple_analysis,

                    var_labels = vars,

                    table_names = vars,

                    format = NULL,

                    na_str = NA_character_,

                    nested = TRUE,

                    ## can't name this na_rm symbol conflict with possible afuns!!

                    inclNAs = FALSE,

                    extra_args = list(),

                    show_labels = c("default", "visible", "hidden"),

                    indent_mod = 0L,

                    section_div = NA_character_) {

  # R treats a single NA value as a logical atomic. The below

  # maps all the NAs in `var_labels` to NA_character_ required by `Split`

  # and avoids the error when `var_labels` is just c(NA).

  if (

      ## this is gross. basically testing

      ## if the symbol we have corresponds

      ## in some meaningful way to the function

      ## we will be calling.

      )

  ) {

  } else {

  }

  )

  } else {

    ## analysis compounding now done in split_rows

  }

}

get_acolvar_name <- function(lyt) {

  ## clyt <- clayout(lyt)

  ## stopifnot(length(clyt) == 1L)

  ## vec = clyt[[1]]

  ## vcls = vapply(vec, class, "")

  ## pos = max(which(vcls ==  "MultiVarSplit"))

}

get_acolvar_vars <- function(lyt) {

  } else {

  }

}

#' Generate rows analyzing different variables across columns

#'

#' @inheritParams lyt_args

#' @param afun (`function` or `list`)\cr function(s) to be used to calculate the values in each column. The list

#'   will be repped out as needed and matched by position with the columns during tabulation. This functions

#'   accepts the same parameters as [analyze()] like `afun` and `format`. For further information see

#'   [additional_fun_params].

#'

#' @inherit split_cols_by return

#'

#' @seealso [split_cols_by_multivar()]

#'

#' @examplesIf require(dplyr)

#' library(dplyr)

#'

#' ANL <- DM %>% mutate(value = rnorm(n()), pctdiff = runif(n()))

#'

#' ## toy example where we take the mean of the first variable and the

#' ## count of >.5 for the second.

#' colfuns <- list(

#'   function(x) rcell(mean(x), format = "xx.x"),

#'   function(x) rcell(sum(x > .5), format = "xx")

#' )

#'

#' lyt <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   split_cols_by_multivar(c("value", "pctdiff")) %>%

#'   split_rows_by("RACE",

#'     split_label = "ethnicity",

#'     split_fun = drop_split_levels

#'   ) %>%

#'   summarize_row_groups() %>%

#'   analyze_colvars(afun = colfuns)

#' lyt

#'

#' tbl <- build_table(lyt, ANL)

#' tbl

#'

#' lyt2 <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   split_cols_by_multivar(c("value", "pctdiff"),

#'     varlabels = c("Measurement", "Pct Diff")

#'   ) %>%

#'   split_rows_by("RACE",

#'     split_label = "ethnicity",

#'     split_fun = drop_split_levels

#'   ) %>%

#'   summarize_row_groups() %>%

#'   analyze_colvars(afun = mean, format = "xx.xx")

#'

#' tbl2 <- build_table(lyt2, ANL)

#' tbl2

#'

#' @author Gabriel Becker

#' @export

analyze_colvars <- function(lyt,

                            afun,

                            format = NULL,

                            na_str = NA_character_,

                            nested = TRUE,

                            extra_args = list(),

                            indent_mod = 0L,

                            inclNAs = FALSE) {

    if (

        ## this is gross. basically testing

        ## if the symbol we have corresponds

        ## in some meaningful way to the function